Optimizing

https://fineli.fi/fineli/fi/elintarvikkeet

FIN: Mahdollisimman vähäsokerinen 7 pv:n ruokavalioehdotus seuraavilla spekseillä: - kokonaisuus mahdollisimman tarkkaan 2000 kcal/pv - energiasta 50% hiilareista, 30% proteiineista, 20% rasvoista mahdollisimman tarkkaan - kuitua vähintään 20 g/pv - ei samasta ruokaryhmästä (esim. “ateriasalaatti” tai “hampurilainen”) peräkkäisinä päivinä - vähintään 5 eri ruoka-ainetta per päivä

ENG: Lowest possible amount of sugar in the 7 days diet with following conditions: - energy intake 2000 kcal/day - of which 50 % should be carbohydrates, 30% protein, 20% fat - at least 20g/day fibers - on the following days, no items from the same foodgroup - at least 5 different items per day

library(readr)
library(dplyr)
library(tidyverse)

options(encoding = "UTF-8", scipen = 999)
Sys.getlocale()
## [1] "fi_FI.UTF-8/fi_FI.UTF-8/fi_FI.UTF-8/C/fi_FI.UTF-8/fi_FI.UTF-8"
#Sys.setlocale("fi_FI.UTF-8/fi_FI.UTF-8/fi_FI.UTF-8/C/fi_FI.UTF-8/fi_FI.UTF-8") #ääkköset

elintarvikkeet <- read_delim("https://fineli.fi/fineli/fi/elintarvikkeet/resultset.csv", 
        ";", escape_double = FALSE, 
        locale = locale("fi", decimal_mark=".",
        asciify = TRUE), 
    na = "N/A", trim_ws = TRUE) %>%  
  mutate_all(funs(str_replace(., "<", "")))%>%
  mutate_at(vars(-"name"),  as.numeric)

summary(elintarvikkeet)
##        id            name           energia, laskennallinen (kJ)
##  Min.   :    1   Length:4098        Min.   :   0.0              
##  1st Qu.: 7176   Class :character   1st Qu.: 330.0              
##  Median :31572   Mode  :character   Median : 644.0              
##  Mean   :22951                      Mean   : 813.6              
##  3rd Qu.:33066                      3rd Qu.:1143.8              
##  Max.   :35566                      Max.   :3700.0              
##                                                                 
##  hiilihydraatti imeytyvä (g)   rasva (g)       proteiini (g)   
##  Min.   :  0.00              Min.   :  0.000   Min.   : 0.000  
##  1st Qu.:  3.40              1st Qu.:  1.400   1st Qu.: 2.400  
##  Median :  9.70              Median :  4.900   Median : 5.600  
##  Mean   : 18.24              Mean   :  9.389   Mean   : 7.816  
##  3rd Qu.: 25.20              3rd Qu.: 11.175   3rd Qu.:10.400  
##  Max.   :100.00              Max.   :100.000   Max.   :92.500  
##                                                NA's   :1       
##   alkoholi (g)      kuitu, kokonais- (g) orgaaniset hapot (g)
##  Min.   : 0.00000   Min.   : 0.000       Min.   : 0.0000     
##  1st Qu.: 0.00000   1st Qu.: 0.100       1st Qu.: 0.0000     
##  Median : 0.00000   Median : 1.000       Median : 0.1000     
##  Mean   : 0.07082   Mean   : 2.035       Mean   : 0.2412     
##  3rd Qu.: 0.00000   3rd Qu.: 2.200       3rd Qu.: 0.3000     
##  Max.   :33.00000   Max.   :85.000       Max.   :10.0000     
##  NA's   :3          NA's   :1            NA's   :235         
##  sokerialkoholi (g) tärkkelys (g)    sokerit (g)      fruktoosi (g)    
##  Min.   : -1.0000   Min.   : 0.00   Min.   :  0.000   Min.   : 0.0000  
##  1st Qu.:  0.0000   1st Qu.: 0.10   1st Qu.:  0.800   1st Qu.: 0.1000  
##  Median :  0.0000   Median : 3.60   Median :  2.500   Median : 0.1000  
##  Mean   :  0.1563   Mean   :11.51   Mean   :  6.647   Mean   : 0.7966  
##  3rd Qu.:  0.0000   3rd Qu.:15.30   3rd Qu.:  6.900   3rd Qu.: 0.6000  
##  Max.   :100.0000   Max.   :97.00   Max.   :100.000   Max.   :99.8000  
##  NA's   :178        NA's   :3                         NA's   :42       
##  galaktoosi (g)     glukoosi (g)       laktoosi (g)      maltoosi (g)  
##  Min.   : 0.0000   Min.   :  0.0000   Min.   : 0.0000   Min.   : 0.00  
##  1st Qu.: 0.0000   1st Qu.:  0.1000   1st Qu.: 0.0000   1st Qu.: 0.00  
##  Median : 0.0000   Median :  0.2000   Median : 0.0000   Median : 0.00  
##  Mean   : 0.1383   Mean   :  0.8824   Mean   : 0.7158   Mean   : 0.11  
##  3rd Qu.: 0.1000   3rd Qu.:  0.9000   3rd Qu.: 0.5000   3rd Qu.: 0.10  
##  Max.   :21.0000   Max.   :100.0000   Max.   :78.0000   Max.   :10.90  
##  NA's   :487       NA's   :47         NA's   :10        NA's   :46     
##  sakkaroosi (g)   polysakkaridi, vesiliukoinen ei-selluloosa (g)
##  Min.   : 0.000   Min.   : 0.0000                               
##  1st Qu.: 0.100   1st Qu.: 0.1000                               
##  Median : 0.300   Median : 0.2000                               
##  Mean   : 3.982   Mean   : 0.3986                               
##  3rd Qu.: 2.800   3rd Qu.: 0.5000                               
##  Max.   :99.900   Max.   :47.1000                               
##  NA's   :35       NA's   :101                                   
##  kuitu veteen liukenematon (g) rasvahapot yhteensä (g)
##  Min.   : 0.000                Min.   : 0.000         
##  1st Qu.: 0.100                1st Qu.: 1.100         
##  Median : 0.600                Median : 4.400         
##  Mean   : 1.168                Mean   : 8.759         
##  3rd Qu.: 1.300                3rd Qu.:10.300         
##  Max.   :62.700                Max.   :99.700         
##  NA's   :101                   NA's   :27             
##  rasvahapot monityydyttymättömät (g)
##  Min.   : 0.000                     
##  1st Qu.: 0.200                     
##  Median : 0.800                     
##  Mean   : 1.822                     
##  3rd Qu.: 1.800                     
##  Max.   :66.000                     
##  NA's   :29                         
##  rasvahapot yksittäistyydyttymättömät cis (g) rasvahapot tyydyttyneet (g)
##  Min.   : 0.000                               Min.   : 0.000             
##  1st Qu.: 0.300                               1st Qu.: 0.300             
##  Median : 1.700                               Median : 1.400             
##  Mean   : 3.548                               Mean   : 3.273             
##  3rd Qu.: 4.300                               3rd Qu.: 3.700             
##  Max.   :70.600                               Max.   :91.300             
##  NA's   :34                                   NA's   :28                 
##  rasvahapot trans (g) rasvahapot n-3 monityydyttymättömät (g)
##  Min.   :0.0000       Min.   : 0.0000                        
##  1st Qu.:0.0000       1st Qu.: 0.1000                        
##  Median :0.1000       Median : 0.1000                        
##  Mean   :0.1158       Mean   : 0.4571                        
##  3rd Qu.:0.1000       3rd Qu.: 0.4000                        
##  Max.   :4.9000       Max.   :53.3000                        
##  NA's   :51           NA's   :40                             
##  rasvahapot n-6 monityydyttymättömät (g)
##  Min.   : 0.000                         
##  1st Qu.: 0.100                         
##  Median : 0.600                         
##  Mean   : 1.365                         
##  3rd Qu.: 1.300                         
##  Max.   :62.300                         
##  NA's   :37                             
##  rasvahappo 18:2 cis,cis n-6 (linolihappo) (mg)
##  Min.   :    0.0                               
##  1st Qu.:  117.0                               
##  Median :  531.5                               
##  Mean   : 1253.7                               
##  3rd Qu.: 1271.5                               
##  Max.   :62280.0                               
##  NA's   :74                                    
##  rasvahappo 18:3 n-3 (alfalinoleenihappo) (mg)
##  Min.   :    0.0                              
##  1st Qu.:   25.0                              
##  Median :   96.0                              
##  Mean   :  336.2                              
##  3rd Qu.:  276.0                              
##  Max.   :53300.0                              
##  NA's   :75                                   
##  rasvahappo 20:5 n-3 (EPA) (mg) rasvahappo 22:6 n-3 (DHA) (mg)
##  Min.   :   0.00                Min.   :   0.00               
##  1st Qu.:   0.00                1st Qu.:   0.00               
##  Median :   0.00                Median :   0.00               
##  Mean   :  16.71                Mean   :  36.64               
##  3rd Qu.:   0.00                3rd Qu.:   5.00               
##  Max.   :1480.00                Max.   :3350.00               
##  NA's   :59                     NA's   :59                    
##  kolesteroli (GC) (mg) sterolit (mg)      kalsium (mg)     
##  Min.   :   0.00       Min.   :   0.00   Min.   :    0.00  
##  1st Qu.:   0.10       1st Qu.:   4.10   1st Qu.:   13.70  
##  Median :   7.20       Median :  16.80   Median :   30.50  
##  Mean   :  27.79       Mean   :  36.62   Mean   :   72.77  
##  3rd Qu.:  38.35       3rd Qu.:  41.75   3rd Qu.:   87.90  
##  Max.   :2680.80       Max.   :7500.00   Max.   :11300.00  
##  NA's   :22            NA's   :167       NA's   :13        
##    rauta (mg)     jodidi (jodi) (µg)  kalium (mg)      magnesium (mg)   
##  Min.   : 0.000   Min.   :     0.0   Min.   :    0.0   Min.   :   0.00  
##  1st Qu.: 0.300   1st Qu.:     3.4   1st Qu.:  134.6   1st Qu.:  11.70  
##  Median : 0.700   Median :    12.3   Median :  197.0   Median :  18.00  
##  Mean   : 1.317   Mean   :   130.1   Mean   :  252.7   Mean   :  29.95  
##  3rd Qu.: 1.300   3rd Qu.:    21.7   3rd Qu.:  304.4   3rd Qu.:  28.00  
##  Max.   :89.800   Max.   :429000.0   Max.   :17880.0   Max.   :1100.00  
##  NA's   :15       NA's   :118        NA's   :16        NA's   :16       
##   natrium (mg)        suola (mg)       fosfori (mg)     seleeni (µg)    
##  Min.   :    0.00   Min.   :    0.0   Min.   :   0.0   Min.   :   0.00  
##  1st Qu.:   43.05   1st Qu.:  109.7   1st Qu.:  51.3   1st Qu.:   1.50  
##  Median :  208.50   Median :  531.1   Median :  96.0   Median :   4.70  
##  Mean   :  351.10   Mean   :  894.4   Mean   : 127.1   Mean   :   8.47  
##  3rd Qu.:  397.45   3rd Qu.: 1011.9   3rd Qu.: 156.5   3rd Qu.:   9.40  
##  Max.   :38700.00   Max.   :98607.6   Max.   :8400.0   Max.   :1917.00  
##  NA's   :3                            NA's   :15       NA's   :16       
##   sinkki (mg)     tryptofaani (mg) folaatti, kokonais- (µg)
##  Min.   : 0.000   Min.   :   0.0   Min.   :   0.00         
##  1st Qu.: 0.300   1st Qu.:  28.0   1st Qu.:   5.60         
##  Median : 0.600   Median :  69.3   Median :  12.65         
##  Mean   : 1.091   Mean   :  98.5   Mean   :  25.80         
##  3rd Qu.: 1.300   3rd Qu.: 126.9   3rd Qu.:  26.43         
##  Max.   :17.800   Max.   :1800.0   Max.   :1435.60         
##  NA's   :17       NA's   :80       NA's   :6               
##  niasiiniekvivalentti NE (mg)
##  Min.   : 0.000              
##  1st Qu.: 0.800              
##  Median : 1.800              
##  Mean   : 2.993              
##  3rd Qu.: 3.900              
##  Max.   :28.700              
##  NA's   :14                  
##  niasiini (nikotiinihappo + nikotiiniamidi) (mg)
##  Min.   : 0.000                                 
##  1st Qu.: 0.200                                 
##  Median : 0.700                                 
##  Mean   : 1.696                                 
##  3rd Qu.: 2.100                                 
##  Max.   :28.200                                 
##  NA's   :14                                     
##  pyridoksiini vitameerit (vetykloridi) (B6) (mg) riboflaviini (B2) (mg)
##  Min.   :0.0000                                  Min.   :0.000         
##  1st Qu.:0.0500                                  1st Qu.:0.050         
##  Median :0.1000                                  Median :0.100         
##  Mean   :0.1643                                  Mean   :0.147         
##  3rd Qu.:0.2000                                  3rd Qu.:0.170         
##  Max.   :2.6200                                  Max.   :9.000         
##  NA's   :13                                      NA's   :12            
##  tiamiini (B1) (mg) B12-vitamiini (kobalamiini) (µg) C-vitamiini (mg) 
##  Min.   :0.0000     Min.   :  0.0000                 Min.   :  0.000  
##  1st Qu.:0.0300     1st Qu.:  0.0000                 1st Qu.:  0.000  
##  Median :0.0600     Median :  0.2000                 Median :  0.800  
##  Mean   :0.1144     Mean   :  0.7933                 Mean   :  6.277  
##  3rd Qu.:0.1100     3rd Qu.:  0.5000                 3rd Qu.:  4.700  
##  Max.   :2.3000     Max.   :110.0000                 Max.   :796.000  
##  NA's   :12         NA's   :2                        NA's   :4        
##  A-vitamiini RAE (µg) karotenoidit (µg)  D-vitamiini (µg) 
##  Min.   :    0.00     Min.   :    0.00   Min.   : 0.0000  
##  1st Qu.:    1.20     1st Qu.:   11.45   1st Qu.: 0.0000  
##  Median :   18.70     Median :   68.80   Median : 0.1000  
##  Mean   :  129.34     Mean   :  642.50   Mean   : 0.9702  
##  3rd Qu.:   60.42     3rd Qu.:  297.50   3rd Qu.: 0.6000  
##  Max.   :25537.00     Max.   :98876.80   Max.   :25.6000  
##  NA's   :2            NA's   :31         NA's   :1        
##  E-vitamiini alfatokoferoli (mg) K-vitamiini (µg)  
##  Min.   : 0.000                  Min.   :   0.000  
##  1st Qu.: 0.200                  1st Qu.:   1.327  
##  Median : 0.600                  Median :   4.230  
##  Mean   : 1.261                  Mean   :  12.452  
##  3rd Qu.: 1.300                  3rd Qu.:  10.463  
##  Max.   :62.200                  Max.   :1714.500  
##  NA's   :9                       NA's   :78

Remove spaces from names in order to refer to them more easily.

colnames(elintarvikkeet) <- gsub(" ", "_", colnames(elintarvikkeet))
colnames(elintarvikkeet) <- gsub("-", "", colnames(elintarvikkeet))
colnames(elintarvikkeet) <- gsub(",", "", colnames(elintarvikkeet))
colnames(elintarvikkeet)<- gsub("[()]", "", colnames(elintarvikkeet))

Select columns needed

elintarvikkeetmod <- elintarvikkeet%>%
  mutate(ruokaryhma=gsub(",.*$", "", name),
         kcal=energia_laskennallinen_kJ*0.239005736,
         sum_hpr=hiilihydraatti_imeytyvä_g+proteiini_g+rasva_g)
  
  
elintarvikkeetmod%>%select(name, ruokaryhma, sokerit_g,
                        energia_laskennallinen_kJ, kcal,
                        hiilihydraatti_imeytyvä_g,
                        proteiini_g,
                        rasva_g,
                        kuitu_kokonais_g, kuitu_veteen_liukenematon_g
                        )%>%summary()
##      name            ruokaryhma          sokerit_g      
##  Length:4098        Length:4098        Min.   :  0.000  
##  Class :character   Class :character   1st Qu.:  0.800  
##  Mode  :character   Mode  :character   Median :  2.500  
##                                        Mean   :  6.647  
##                                        3rd Qu.:  6.900  
##                                        Max.   :100.000  
##                                                         
##  energia_laskennallinen_kJ      kcal        hiilihydraatti_imeytyvä_g
##  Min.   :   0.0            Min.   :  0.00   Min.   :  0.00           
##  1st Qu.: 330.0            1st Qu.: 78.87   1st Qu.:  3.40           
##  Median : 644.0            Median :153.92   Median :  9.70           
##  Mean   : 813.6            Mean   :194.47   Mean   : 18.24           
##  3rd Qu.:1143.8            3rd Qu.:273.36   3rd Qu.: 25.20           
##  Max.   :3700.0            Max.   :884.32   Max.   :100.00           
##                                                                      
##   proteiini_g        rasva_g        kuitu_kokonais_g
##  Min.   : 0.000   Min.   :  0.000   Min.   : 0.000  
##  1st Qu.: 2.400   1st Qu.:  1.400   1st Qu.: 0.100  
##  Median : 5.600   Median :  4.900   Median : 1.000  
##  Mean   : 7.816   Mean   :  9.389   Mean   : 2.035  
##  3rd Qu.:10.400   3rd Qu.: 11.175   3rd Qu.: 2.200  
##  Max.   :92.500   Max.   :100.000   Max.   :85.000  
##  NA's   :1                          NA's   :1       
##  kuitu_veteen_liukenematon_g
##  Min.   : 0.000             
##  1st Qu.: 0.100             
##  Median : 0.600             
##  Mean   : 1.168             
##  3rd Qu.: 1.300             
##  Max.   :62.700             
##  NA's   :101
library(ggplot2)
library(GGally)

elintarvikkeetmod%>%select(ruokaryhma, sokerit_g,
                        energia_laskennallinen_kJ, kcal,
                        hiilihydraatti_imeytyvä_g,
                        proteiini_g,
                        rasva_g,
                        kuitu_kokonais_g
                        )%>%ggpairs(.
                                    ,columns = 2:8
                                    #,mapping=aes(colour=ruokaryhma)
                                    ) +theme_minimal()

And another picture

library(plotly)
selected <- c("Ateriasalaatti", "Hampurilainen")

elintarvikkeetmod%>%select(name, ruokaryhma, sokerit_g,
                        energia_laskennallinen_kJ, kcal,
                        hiilihydraatti_imeytyvä_g,
                        proteiini_g,
                        rasva_g,
                        kuitu_kokonais_g
                        )%>%
  filter(ruokaryhma %in% selected)%>%
   plot_ly(data = ., x = ~kcal, y = ~sokerit_g, color = ~ruokaryhma,
           text = ~name)
elintarvikkeetmod%>%select(name, ruokaryhma, sokerit_g,
                        energia_laskennallinen_kJ, kcal,
                        hiilihydraatti_imeytyvä_g,
                        proteiini_g,
                        rasva_g,
                        kuitu_kokonais_g
                        )%>%
  filter(ruokaryhma %in% selected)%>%
   plot_ly(data = ., x = ~kcal, y = ~proteiini_g, color = ~ruokaryhma,
           text = ~name)

The objective function in the above problem will be:

min(sokerit)

when 0.5hiilarit+0.3proteiini+0.2rasvat 2000kcal min(kuitu)=20g count(rows)>=5

library(lpSolve)
 # Constraint matrix
constraints <- rbind(elintarvikkeetmod$kcal,
                elintarvikkeetmod$kcal, 
                elintarvikkeetmod$kuitu_kokonais_g, 
                nrow(elintarvikkeetmod),
                (elintarvikkeetmod$hiilihydraatti_imeytyvä_g/elintarvikkeetmod$sum_hpr),
                (elintarvikkeetmod$proteiini_g/elintarvikkeetmod$sum_hpr),
                (elintarvikkeetmod$rasva_g/elintarvikkeetmod$sum_hpr)
               
                )

mod <- lp("min",  # min/max
          elintarvikkeetmod$sokerit_g,  # Objective
         constraints   ,  # Constraint matrix
          c(">=", "<=", ">=",">=", ">=",">=",">="),  # Constraint directions
          c(1990,2010, 20,5, 0.5,0.3,0.2), #Limits
          all.bin = TRUE
         ,num.bin.solns = 150
)


mod
## Success: the objective function is 0 
##   150 solutions returned

Results

### solve the problem multiple times
#solved1<- lp("max", f.obj, f.con, f.dir, f.rhs, all.bin=TRUE,   num.bin.solns = 10)
#solved1

numcols <- ncol(constraints) 
numsols <- mod$num.bin.solns

solutions_all <- matrix(head(mod$solution, numcols*numsols), nrow=numsols, byrow=TRUE)


##attach them to the dataframe
for(i in 1:numsols){
  elintarvikkeetmod[, ncol(elintarvikkeetmod) + 1] <- solutions_all[i,]#rnorm(nrow(simple))
  names(elintarvikkeetmod)[ncol(elintarvikkeetmod)] <- paste0("solution", i)
}

Check results

library(tidyr)
library(reshape2)
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths
solutionstacked<- elintarvikkeetmod%>%
  select(ruokaryhma, name, kcal,sokerit_g,kuitu_kokonais_g, solution1:paste0("solution",numsols))%>%
  reshape2::melt(., id=c("ruokaryhma","name","kcal", "sokerit_g", "kuitu_kokonais_g"))%>%
  filter(value==1)

solutionstacked%>%
  group_by(variable)%>%
  summarise(sum_kcal=sum(kcal),
            sum_sokerit=sum(sokerit_g),
            sum_kuitu=sum(kuitu_kokonais_g))%>%
  head()
## # A tibble: 6 x 4
##   variable  sum_kcal sum_sokerit sum_kuitu
##   <fct>        <dbl>       <dbl>     <dbl>
## 1 solution1    2010.           0      34.6
## 2 solution2    2010.           0      34.6
## 3 solution3    1996.           0      36  
## 4 solution4    2010.           0      34.6
## 5 solution5    1996.           0      36  
## 6 solution6    2010.           0      34.6

Select 7 day diet from the options, no same ruokaryhmä on consecutive days

library(tidyr)
library(reshape)


solutionstackedmatrix <- solutionstacked%>%
  select(ruokaryhma, name, variable, value)%>%
  reshape::cast(., ruokaryhma+name ~ variable, mean)

firstselection <- elintarvikkeetmod%>%
  select(solution1:paste0("solution",numsols))%>%
  names()%>%
  sample(., 1, replace = FALSE, prob = NULL)

discard <- solutionstacked%>%filter(variable==firstselection)%>%
  group_by(variable, ruokaryhma)%>%summarise(n=n())

nextselectiondiscard <-solutionstacked %>%
    group_by(variable) %>%
    filter(!any(ruokaryhma %in% discard$ruokaryhma))%>%
    select(variable)%>%as.list()

nextselectiondiscard
## $variable
## factor(0)
## 150 Levels: solution1 solution2 solution3 solution4 solution5 ... solution150
## 
## attr(,"vars")
## [1] "variable"
## attr(,"drop")
## [1] TRUE
## attr(,"indices")
## list()
## attr(,"group_sizes")
## integer(0)
## attr(,"biggest_group_size")
## [1] 0
## attr(,"labels")
## [1] variable
## <0 rows> (or 0-length row.names)
##doesn't give any other 'ruokaryhmä' :(

#nextselection<- 

With these results /approach it is not possible to select from different food groups!